home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 4 / Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso / Development / Source / DBL Pascal Library / Utils / NuDialogUtils next >
Text File  |  1993-06-27  |  15KB  |  549 lines
  1. unit NuDialogUtils;
  2.  
  3. interface
  4.  
  5.     { Getting and setting the handle of any DITL }
  6.     procedure SetDItemHdl (dItem: Integer; newHdl: Handle);
  7.     function GetDItemHdl (dItem: Integer): Handle;
  8.  
  9.     {User item procs}
  10.     procedure FrameItemProc (window: WindowPtr; item: Integer);
  11.     procedure DottedFrameItemProc (window: WindowPtr; item: Integer);
  12.     procedure BoldItemProc (window: WindowPtr; item: Integer);
  13.     procedure ListRedrawProc (window: WindowPtr; list: ListHandle; item: Integer);
  14.  
  15.     {Utilities expect the port to be set to current dialog}
  16.     function GetDItemFrame (item: Integer): Rect;
  17.     procedure SetDItemFrame (item: Integer; newRect: Rect);
  18.     function VisibleDItem (item: Integer): Boolean;
  19.     procedure SetDItemProc (item: Integer; proc: ProcPtr);
  20.     procedure SetDIconID (item: Integer; icon: Integer);
  21.     procedure SetDItemText (item: Integer; theString: Str255);
  22.     function GetDItemText (item: Integer): Str255;
  23.     procedure SelectDEditText (item, selStart, selEnd: Integer);
  24.     function NewDTextList (item, rows, columns: Integer; scrollHoriz, scrollVert: Boolean): ListHandle;    {ideally, item height should be n*cell_height+2}
  25.     function GetDControlHandle (item: Integer): ControlHandle;
  26.     function GetDControlValue (item: Integer): Integer;
  27.     procedure SetDControlValue (item, value: Integer);
  28.     function GetDControlMin (item: Integer): Integer;
  29.     procedure SetDControlMin (item, value: Integer);
  30.     function GetDControlMax (item: Integer): Integer;
  31.     procedure SetDControlMax (item, value: Integer);
  32.     procedure RadioButtonDClick (first, last, item: Integer);
  33.     function GetDRadioGroupValue (first, last: Integer): Integer;    {zero-based, -1 if no RB pushed}
  34.     procedure CheckboxDClick (item: Integer);
  35.     function GetDControlEnable (item: Integer): Boolean;
  36.     procedure SetDControlEnable (item: Integer; enable: Boolean);
  37.     procedure RefreshDControl (item: Integer);
  38.     function TestDControlChanged (item: Integer; saveLoc: Ptr): Boolean;    {saveLoc points to integer — if nil, use high bytes of contrlRfcon}
  39.     procedure UpdateParamText (theString: Str255; whichParam, whichItem: Integer);
  40.  
  41.     {Move a dialog to the proper position}
  42.     procedure PositionDialog (dlg: DialogPtr);
  43.     procedure PositionAlertTemplate (templateID: Integer);
  44.  
  45.     {Hilite a button to give feedback for key–equivalent hits}
  46.     procedure FlashButton (item: Integer);
  47.  
  48.     {Do standard return/enter and command-period/escape key filtering}
  49.     function OKCancelKeyFilter (dlg: DialogPtr; var evt: EventRecord; var itemHit: INTEGER; ignoreReturn, ignoreCancel: Boolean): BOOLEAN;
  50.  
  51.     {Hide/show entire groups of dialog items.}
  52.     type
  53.         DItemIDSet = set of 1..255;
  54.     procedure ShowDItemSet (items: DItemIDSet);
  55.     procedure HideDItemSet (items: DItemIDSet);
  56.     function GetIBeamRegion (items: DItemIDSet): RgnHandle;    {Make a region from rects of group of dialog items.}
  57.  
  58.     {Hide/show list box scroll bars.}
  59.     procedure HideLBScrollBars (theLB: ListHandle);
  60.     procedure ShowLBScrollBars (theLB: ListHandle);
  61.  
  62. implementation
  63.  
  64.     uses
  65.         Script;
  66.  
  67.     function GetDItemHdl (dItem: Integer): Handle;
  68.         var
  69.             dPtr: DialogPtr;
  70.             dType: Integer;
  71.             dHndl: Handle;
  72.             dRect: Rect;
  73.     begin
  74.         GetPort(GrafPtr(dPtr));
  75.         GetDItem(dPtr, dItem, dType, dHndl, dRect);
  76.         GetDItemHdl := dHndl;
  77.     end; { GetDItemHdl }
  78.  
  79.     procedure SetDItemHdl (dItem: Integer; newHdl: Handle);
  80.         var
  81.             dPtr: DialogPtr;
  82.             dType: Integer;
  83.             dHndl: Handle;
  84.             dRect: Rect;
  85.     begin
  86.         GetPort(GrafPtr(dPtr));
  87.         GetDItem(dPtr, dItem, dType, dHndl, dRect);
  88.         SetDItem(dPtr, dItem, dType, newHdl, dRect);
  89.     end; { GetDItemHdl }
  90.  
  91.     procedure FrameItemProc (window: WindowPtr; item: Integer);
  92.     begin
  93.         PenNormal;
  94.         FrameRect(GetDItemFrame(item));
  95.     end;
  96.  
  97.     procedure DottedFrameItemProc (window: WindowPtr; item: Integer);
  98.     begin
  99.         PenNormal;
  100.         PenPat(gray);
  101.         FrameRect(GetDItemFrame(item));
  102.         PenPat(black);
  103.     end;
  104.  
  105.     procedure BoldItemProc (window: WindowPtr; item: Integer);
  106.     begin
  107.         PenNormal;
  108.         PenSize(3, 3);
  109.         FrameRoundRect(GetDItemFrame(item), 16, 16);
  110.     end;
  111.  
  112.     procedure ListRedrawProc (window: WindowPtr; list: ListHandle; item: Integer);
  113.         var
  114.             itemRect: Rect;
  115.     begin
  116.         itemRect := GetDItemFrame(item);
  117.         if itemRect.left <= 8192 then    {it hasn't been hidden}
  118.             LUpdate(list^^.port^.visRgn, list);
  119.         PenNormal;
  120.         FrameRect(itemRect);
  121.     end;
  122.  
  123.     function GetDItemFrame (item: Integer): Rect;
  124.         var
  125.             theDialog: DialogPtr;
  126.             itemKind: Integer;
  127.             itemHandle: Handle;
  128.             itemRect: Rect;
  129.     begin
  130.         GetPort(GrafPtr(theDialog));
  131.         GetDItem(theDialog, item, itemKind, itemHandle, itemRect);
  132.         GetDItemFrame := itemRect;
  133.     end;
  134.  
  135.     procedure SetDItemFrame (item: Integer; newRect: Rect);
  136.         var
  137.             theDialog: DialogPtr;
  138.             itemKind: Integer;
  139.             itemHandle: Handle;
  140.             itemRect: Rect;
  141.     begin
  142.         GetPort(GrafPtr(theDialog));
  143.         GetDItem(theDialog, item, itemKind, itemHandle, itemRect);
  144.         SetDItem(theDialog, item, itemKind, itemHandle, newRect);
  145.     end;
  146.  
  147.     function VisibleDItem (item: Integer): Boolean;
  148.     begin
  149.         VisibleDItem := GetDItemFrame(item).left > 8192;
  150.     end;
  151.  
  152.     procedure SetDItemProc (item: Integer; proc: ProcPtr);
  153.         var
  154.             theDialog: DialogPtr;
  155.             itemKind: Integer;
  156.             itemHandle: Handle;
  157.             itemRect: Rect;
  158.     begin
  159.         GetPort(GrafPtr(theDialog));
  160.         GetDItem(theDialog, item, itemKind, itemHandle, itemRect);
  161.         SetDItem(theDialog, item, itemKind, Handle(proc), itemRect);
  162.     end;
  163.  
  164.     procedure SetDIconID (item: Integer; icon: Integer);
  165.         var
  166.             theDialog: DialogPtr;
  167.             itemKind: Integer;
  168.             itemHandle: Handle;
  169.             itemRect: Rect;
  170.     begin
  171.         GetPort(GrafPtr(theDialog));
  172.         GetDItem(theDialog, item, itemKind, itemHandle, itemRect);
  173.         SetDItem(theDialog, item, itemKind, GetIcon(icon), itemRect);
  174.     end;
  175.  
  176.     procedure SetDItemText (item: Integer; theString: Str255);
  177.         var
  178.             theDialog: DialogPtr;
  179.             itemKind: Integer;
  180.             itemHandle: Handle;
  181.             itemRect: Rect;
  182.     begin
  183.         GetPort(GrafPtr(theDialog));
  184.         GetDItem(theDialog, item, itemKind, itemHandle, itemRect);
  185.         SetIText(itemHandle, theString);
  186.     end;
  187.  
  188.     function GetDItemText (item: Integer): Str255;
  189.         var
  190.             theDialog: DialogPtr;
  191.             itemKind: Integer;
  192.             itemHandle: Handle;
  193.             itemRect: Rect;
  194.             theString: Str255;
  195.     begin
  196.         GetPort(GrafPtr(theDialog));
  197.         GetDItem(theDialog, item, itemKind, itemHandle, itemRect);
  198.         GetIText(itemHandle, theString);
  199.         GetDItemText := theString;
  200.     end;
  201.  
  202.     procedure SelectDEditText (item, selStart, selEnd: Integer);
  203.         var
  204.             theDialog: DialogPtr;
  205.     begin
  206.         GetPort(GrafPtr(theDialog));
  207.         SelIText(theDialog, item, selStart, selEnd);
  208.     end;
  209.  
  210.     function NewDTextList (item, rows, columns: Integer; scrollHoriz, scrollVert: Boolean): ListHandle;
  211.         var
  212.             theDialog: DialogPtr;
  213.             itemKind: Integer;
  214.             itemHandle: Handle;
  215.             itemRect: Rect;
  216.             dataBounds: Rect;
  217.             cSize: Point;
  218.     begin
  219.         GetPort(GrafPtr(theDialog));
  220.         GetDItem(theDialog, item, itemKind, itemHandle, itemRect);
  221.         InsetRect(itemRect, 1, 1);
  222.         if scrollVert then
  223.             itemRect.right := itemRect.right - 15;
  224.         if scrollHoriz then
  225.             itemRect.bottom := itemRect.bottom - 15;
  226.         cSize := Point(0);
  227.         SetRect(dataBounds, 0, 0, columns, rows);
  228.         NewDTextList := LNew(itemRect, dataBounds, cSize, 0, theDialog, True, False, scrollHoriz, scrollVert);
  229.     end;
  230.  
  231.     function GetDControlHandle (item: Integer): ControlHandle;
  232.         var
  233.             theDialog: DialogPtr;
  234.             kind: Integer;
  235.             h: Handle;
  236.             r: Rect;
  237.     begin
  238.         GetPort(GrafPtr(theDialog));
  239.         GetDItem(theDialog, item, kind, h, r);
  240.         if BAND(kind, $FC) = ctrlItem then
  241.             GetDControlHandle := ControlHandle(h)
  242.         else
  243.             GetDControlHandle := nil;
  244.     end;
  245.  
  246.     function GetDControlValue (item: Integer): Integer;
  247.     begin
  248.         GetDControlValue := GetCtlValue(GetDControlHandle(item));
  249.     end;
  250.  
  251.     procedure SetDControlValue (item, value: Integer);
  252.     begin
  253.         SetCtlValue(GetDControlHandle(item), value);
  254.     end;
  255.  
  256.     function GetDControlMin (item: Integer): Integer;
  257.     begin
  258.         GetDControlMin := GetCtlMin(GetDControlHandle(item));
  259.     end;
  260.  
  261.     procedure SetDControlMin (item, value: Integer);
  262.     begin
  263.         SetCtlMin(GetDControlHandle(item), value);
  264.     end;
  265.  
  266.     function GetDControlMax (item: Integer): Integer;
  267.     begin
  268.         GetDControlMax := GetCtlMax(GetDControlHandle(item));
  269.     end;
  270.  
  271.     procedure SetDControlMax (item, value: Integer);
  272.     begin
  273.         SetCtlMax(GetDControlHandle(item), value);
  274.     end;
  275.  
  276.     procedure RadioButtonDClick (first, last, item: Integer);
  277.         var
  278.             i: Integer;
  279.     begin
  280.         for i := first to last do
  281.             SetDControlValue(i, ORD(i = item));
  282.     end;
  283.  
  284.     function GetDRadioGroupValue (first, last: Integer): Integer;
  285.         var
  286.             i: Integer;
  287.     begin
  288.         GetDRadioGroupValue := -1;
  289.         for i := first to last do
  290.             if GetDControlValue(i) = 1 then
  291.                 begin
  292.                     GetDRadioGroupValue := i - first;
  293.                     Leave;
  294.                 end;
  295.     end;
  296.  
  297.     procedure CheckboxDClick (item: Integer);
  298.         var
  299.             h: ControlHandle;
  300.     begin
  301.         h := GetDControlHandle(item);
  302.         SetCtlValue(h, 1 - GetCtlValue(h));
  303.     end;
  304.  
  305.     function GetDControlEnable (item: Integer): Boolean;
  306.         var
  307.             handle: ControlHandle;
  308.     begin
  309.         handle := GetDControlHandle(item);
  310.         if handle <> nil then
  311.             GetDControlEnable := handle^^.contrlHilite <> 255
  312.         else
  313.             GetDControlEnable := False;
  314.     end;
  315.  
  316.     procedure SetDControlEnable (item: Integer; enable: Boolean);
  317.         var
  318.             hilite: Integer;
  319.     begin
  320.         if enable then
  321.             hilite := 0
  322.         else
  323.             hilite := 255;
  324.         HiliteControl(GetDControlHandle(item), hilite);
  325.     end;
  326.  
  327.     procedure RefreshDControl (item: Integer);
  328.     begin
  329.         Draw1Control(GetDControlHandle(item));
  330.     end;
  331.  
  332.     function TestDControlChanged (item: Integer; saveLoc: Ptr): Boolean;
  333.         type
  334.             IntPtr = ^Integer;
  335.         var
  336.             controlH: ControlHandle;
  337.             changed: Boolean;
  338.     begin
  339.         controlH := GetDControlHandle(item);
  340.         with controlH^^ do
  341.             begin
  342.                 if saveLoc = nil then
  343.                     saveLoc := @contrlRfcon;
  344.                 changed := contrlValue <> IntPtr(saveLoc)^;
  345.                 IntPtr(saveLoc)^ := contrlValue;
  346.             end;
  347.         TestDControlChanged := changed;
  348.     end;
  349.  
  350.  
  351.     procedure UpdateParamText (theString: Str255; whichParam, whichItem: Integer);
  352.         const
  353.             DAStrings = $AA0;
  354.         type
  355.             ParamTextArray = array[0..3] of StringHandle;
  356.             ParamTextArrayPtr = ^ParamTextArray;
  357.         var
  358.             s: array[0..3] of Str255;
  359.             J: integer;
  360.             theDialog: DialogPtr;
  361.             itemKind: Integer;
  362.             itemHandle: Handle;
  363.             itemRect: Rect;
  364.     begin            {UpdateParamText}
  365.         for J := 0 to 3 do
  366.             if ParamTextArrayPtr(DAStrings)^[J] = nil then
  367.                 s[J] := ''
  368.             else
  369.                 s[J] := ParamTextArrayPtr(DAStrings)^[J]^^;
  370.         if s[whichParam] <> theString then
  371.             begin
  372.                 s[whichParam] := theString;
  373.                 ParamText(s[0], s[1], s[2], s[3]);
  374.                 GetPort(GrafPtr(theDialog));
  375.                 GetDItem(theDialog, whichItem, itemKind, itemHandle, itemRect);
  376.                 InvalRect(itemRect);    {let update event force the redrawing}
  377.             end;
  378.     end;            {UpdateParamText}
  379.  
  380.  
  381.     procedure PositionDialog (dlg: DialogPtr);    {Revised to account for structure region.}
  382.         var
  383.             deskRect: Rect;
  384.             vSpace, hSpace: Integer;
  385.             vStruc, hStruc: Integer;
  386.             vOffset, hOffset: Integer;
  387.     begin
  388.         deskRect := screenBits.bounds;
  389.         with deskRect do
  390.             begin
  391.                 top := top + GetMBarHeight;
  392.                 vSpace := bottom - top;
  393.                 hSpace := right - left;
  394.             end;
  395.         MoveWindow(dlg, -8192, -8192, False);        {Move it way off screen.}
  396.         ShowHide(dlg, true);        {Get the regions built, without generating any activate events.}
  397. {Calculate the dialog’s entire structure size.}
  398.         with WindowPeek(dlg)^.strucRgn^^.rgnBBox do
  399.             begin
  400.                 vStruc := bottom - top;
  401.                 hStruc := right - left;
  402.             end;
  403. {Compute the borders around the contents but within the structure.  This is how much we need}
  404. {to offset the MoveWindow, which works relative to the contents, to account for the structure.}
  405.         with WindowPeek(dlg)^.contRgn^^.rgnBBox do
  406.             begin
  407.                 hOffset := (hStruc - (right - left)) div 2;        {1/2 on right, 1/2 on left…}
  408.                 vOffset := vStruc - (bottom - top) - hOffset;    {and 1/2 on bottom.}
  409.             end;
  410.         ShowHide(dlg, false);    {Make it disappear, quietly.}
  411. {Now the available space is the screen less the structure.}
  412.         vSpace := vSpace - vStruc;
  413.         hSpace := hSpace - hStruc;
  414. {We can now “center” the window in a visually attractive manner.}
  415.         with deskRect do
  416.             MoveWindow(dlg, left + hOffset + (hSpace div 2), top + vOffset + (vSpace div 3), False);
  417.     end;
  418.  
  419.     procedure PositionAlertTemplate (templateID: Integer);
  420.         var
  421.             theTemplate: AlertTHndl;
  422.             deskRect: Rect;
  423.             vSpace, hSpace: Integer;
  424.             vOffset, hOffset: Integer;
  425.     begin
  426.         theTemplate := AlertTHndl(GetResource('ALRT', templateID));
  427.         if theTemplate <> nil then
  428.             begin
  429.                 deskRect := screenBits.bounds;
  430.                 with deskRect do
  431.                     begin
  432.                         top := top + GetMBarHeight;
  433.                         vSpace := bottom - top;
  434.                         hSpace := right - left;
  435.                     end;
  436.                 with theTemplate^^, boundsRect do
  437.                     begin
  438.                         vSpace := vSpace - bottom + top;
  439.                         hSpace := hSpace - right + left;
  440.                         OffsetRect(boundsRect, -left, -top);    {normalize top left to zero zero}
  441.                     end;
  442.                 with deskRect do
  443.                     OffsetRect(theTemplate^^.boundsRect, left + hSpace div 2, top + vSpace div 3);
  444.             end;
  445.     end;
  446.  
  447.     procedure FlashButton (item: Integer);
  448.         const
  449.             hiliteTicks = 8;
  450.         var
  451.             button: ControlHandle;
  452.             time: Longint;
  453.     begin
  454.         button := GetDControlHandle(item);
  455.         HiliteControl(button, 1);
  456.         Delay(hiliteTicks, time);
  457.         HiliteControl(button, 0);
  458.     end;
  459.  
  460.     {This depends upon the standard OK and cancel item assignments.}
  461.     function OKCancelKeyFilter (dlg: DialogPtr; var evt: EventRecord; var itemHit: INTEGER; ignoreReturn, ignoreCancel: Boolean): BOOLEAN;
  462.         var
  463.             theCharCode: Integer;
  464.             fakeItem: Integer;
  465.     begin
  466.         OKCancelKeyFilter := False;
  467.         if evt.what = keyDown then
  468.             begin
  469.                 theCharCode := BAND(evt.message, charCodeMask);
  470.                 if GetDControlEnable(OK) & ((theCharCode = $03) | ((theCharCode = $0D) & not ignoreReturn)) then
  471.                     fakeItem := OK
  472.                 else if GetDControlEnable(cancel) & not ignoreCancel & ((theCharCode = ORD('.')) & (BAND(evt.modifiers, cmdKey) <> 0) | (theCharCode = $1B)) then
  473.                     fakeItem := cancel
  474.                 else
  475.                     fakeItem := 0;
  476.                 if fakeItem > 0 then
  477.                     begin
  478.                         FlashButton(fakeItem);
  479.                         itemHit := fakeItem;
  480.                         OKCancelKeyFilter := True;
  481.                     end;
  482.             end;
  483.     end;
  484.  
  485.     procedure ShowDItemSet (items: DItemIDSet);
  486.         var
  487.             theDialog: DialogPtr;
  488.             i: Integer;
  489.     begin
  490.         GetPort(GrafPtr(theDialog));
  491.         for i := 1 to 255 do
  492.             if i in items then
  493.                 ShowDItem(theDialog, i);
  494.     end;
  495.  
  496.     procedure HideDItemSet (items: DItemIDSet);
  497.         var
  498.             theDialog: DialogPtr;
  499.             i: Integer;
  500.     begin
  501.         GetPort(GrafPtr(theDialog));
  502.         for i := 1 to 255 do
  503.             if i in items then
  504.                 HideDItem(theDialog, i);
  505.     end;
  506.  
  507.  
  508.     function GetIBeamRegion (items: DItemIDSet): RgnHandle;
  509.         var
  510.             J: INTEGER;
  511.             myRegion: RgnHandle;
  512.     begin            {GetIBeamRegion}
  513.         myRegion := NewRgn;
  514.         OpenRgn;
  515.         for J := 1 to 255 do
  516.             if J in items then
  517.                 FrameRect(GetDItemFrame(J));
  518.         CloseRgn(myRegion);
  519.         GetIBeamRegion := myRegion;
  520.     end;            {GetIBeamRegion}
  521.  
  522.  
  523.     procedure HideLBScrollBars (theLB: ListHandle);
  524.     begin
  525.         HLock(Handle(theLB));
  526.         with theLB^^ do
  527.             begin
  528.                 if vScroll <> nil then
  529.                     HideControl(vScroll);
  530.                 if hScroll <> nil then
  531.                     HideControl(hScroll);
  532.             end;
  533.         HUnlock(Handle(theLB));
  534.     end;
  535.  
  536.     procedure ShowLBScrollBars (theLB: ListHandle);
  537.     begin
  538.         HLock(Handle(theLB));
  539.         with theLB^^ do
  540.             begin
  541.                 if vScroll <> nil then
  542.                     ShowControl(vScroll);
  543.                 if hScroll <> nil then
  544.                     ShowControl(hScroll);
  545.             end;
  546.         HUnlock(Handle(theLB));
  547.     end;
  548.  
  549. end.